indiv smooths
William Norfolk
10/14/2020
Load all required libraries.
library(tidyverse)## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.5 v purrr 0.3.4
## v tibble 3.1.3 v dplyr 1.0.7
## v tidyr 1.1.3 v stringr 1.4.0
## v readr 2.0.0 v forcats 0.5.1## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove facilty C for now
#only_n1 <- only_n1[!(only_n1$Facility == "WRF C"),]
#only_n2 <- only_n2[!(only_n2$Facility == "WRF C"),]
only_n1 <- only_n1[!(only_n1$Facility == "WRF A" & only_n1$date == "2020-11-02"), ]
only_n2 <- only_n2[!(only_n2$Facility == "WRF A" & only_n2$date == "2020-11-02"), ]Build the main plot
#first layer is the background epidemic curve
p1 <- only_background %>%
plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~new_cases_clarke,
type = "bar",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Daily Cases: ', new_cases_clarke),
alpha = 0.5,
name = "Daily Reported Cases",
color = background_color,
colors = background_color,
showlegend = FALSE) %>%
layout(yaxis = list(title = "Clarke County Daily Cases", showline=TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#renders the main plot layer two as seven day moving average
p1 <- p1 %>% plotly::add_trace(x = ~date, y = ~X7_day_ave_clarke,
type = "scatter",
mode = "lines",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Seven-Day Moving Average: ', X7_day_ave_clarke),
name = "Seven Day Moving Average Athens",
line = list(color = seven_day_ave_color),
showlegend = FALSE)
#renders the main plot layer three as positive target hits
p2 <- plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n1,
symbol = ~Facility,
marker = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n2,
symbol = ~Facility,
marker = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(yaxis = list(title = "SARS CoV-2 Copies/L",
showline = TRUE,
type = "log",
dtick = 1,
automargin = TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#adds the limit of detection dashed line
p2 <- p2 %>% plotly::add_segments(x = as.Date("2020-03-14"),
xend = ~max(date + 10),
y = 3571.429, yend = 3571.429,
opacity = 0.35,
line = list(color = "black", dash = "dash")) %>%
layout(annotations = list(x = as.Date("2020-03-28"), y = 3.8, xref = "x", yref = "y",
text = "Limit of Detection", showarrow = FALSE))
p1 p2Combine the two main plot pieces as a subplot
#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")
#rejoin the old data frames then seperate in to averages for each plant.
wrfa_both <- full_join(wrf_a_only_n1, wrf_a_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")wrfb_both <- full_join(wrf_b_only_n1, wrf_b_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")wrfc_both <- full_join(wrf_c_only_n1, wrf_c_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")#get max date
maxdate <- max(wrfa_both$date)
mindate <- min(wrfa_both$date)Build loess smoothing figures figures
This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_botha <- ggplot(wrfa_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_botha<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 457)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_botha## `geom_smooth()` using formula 'y ~ x'
fit_botha## [1] 12.90660 12.90692 12.90721 12.90748 12.90773 12.90796 12.90818 12.90838
## [9] 12.90856 12.90873 12.90890 12.90905 12.90920 12.90935 12.90949 12.90963
## [17] 12.90978 12.90992 12.91007 12.91023 12.91040 12.91058 12.91077 12.91098
## [25] 12.91120 12.91144 12.91170 12.91198 12.91229 12.91262 12.91298 12.91337
## [33] 12.91379 12.91424 12.91473 12.91525 12.91581 12.91642 12.91706 12.91775
## [41] 12.91849 12.91927 12.92011 12.92099 12.92192 12.92290 12.92393 12.92500
## [49] 12.92610 12.92725 12.92843 12.92965 12.93090 12.93217 12.93348 12.93481
## [57] 12.93617 12.93755 12.93894 12.94036 12.94179 12.94324 12.94469 12.94616
## [65] 12.94763 12.94911 12.95059 12.95207 12.95355 12.95503 12.95651 12.95797
## [73] 12.95943 12.96087 12.96231 12.96372 12.96512 12.96650 12.96786 12.96920
## [81] 12.97051 12.97179 12.97304 12.97426 12.97544 12.97659 12.97770 12.97877
## [89] 12.97980 12.98079 12.98172 12.98261 12.98354 12.98461 12.98579 12.98709
## [97] 12.98850 12.99001 12.99161 12.99330 12.99507 12.99691 12.99882 13.00078
## [105] 13.00280 13.00485 13.00695 13.00907 13.01121 13.01337 13.01553 13.01769
## [113] 13.01985 13.02199 13.02410 13.02619 13.02824 13.03025 13.03220 13.03410
## [121] 13.03593 13.03769 13.03937 13.04095 13.04245 13.04384 13.04513 13.04629
## [129] 13.04733 13.04824 13.04902 13.04964 13.05012 13.05043 13.05058 13.05098
## [137] 13.05205 13.05370 13.05590 13.05858 13.06169 13.06517 13.06896 13.07301
## [145] 13.07725 13.08164 13.08611 13.09060 13.09507 13.09945 13.10369 13.10773
## [153] 13.11150 13.11497 13.11806 13.12072 13.12290 13.12454 13.12557 13.12595
## [161] 13.12561 13.12510 13.12497 13.12518 13.12572 13.12655 13.12763 13.12895
## [169] 13.13046 13.13214 13.13397 13.13590 13.13791 13.13997 13.14205 13.14412
## [177] 13.14615 13.14811 13.14997 13.15169 13.15326 13.15463 13.15579 13.15669
## [185] 13.15732 13.15763 13.15760 13.15721 13.15641 13.15518 13.15349 13.15131
## [193] 13.14861 13.14535 13.14152 13.13708 13.13179 13.12551 13.11830 13.11024
## [201] 13.10141 13.09188 13.08173 13.07104 13.05988 13.04833 13.03646 13.02435
## [209] 13.01208 12.99973 12.98736 12.97506 12.96290 12.95096 12.93931 12.92803
## [217] 12.91720 12.90689 12.89718 12.88739 12.87682 12.86551 12.85347 12.84074
## [225] 12.82735 12.81334 12.79872 12.78354 12.76782 12.75159 12.73489 12.71774
## [233] 12.70018 12.68223 12.66393 12.64530 12.62638 12.60720 12.58778 12.56816
## [241] 12.54837 12.52845 12.50840 12.48828 12.46811 12.44793 12.42775 12.40761
## [249] 12.38755 12.36759 12.34776 12.32810 12.30863 12.28939 12.27040 12.25170
## [257] 12.23331 12.21527 12.19761 12.18035 12.16354 12.14719 12.13134 12.11602
## [265] 12.10127 12.08710 12.07310 12.05885 12.04438 12.02975 12.01497 12.00010
## [273] 11.98517 11.97022 11.95529 11.94041 11.92563 11.91098 11.89650 11.88222
## [281] 11.86820 11.85445 11.84104 11.82798 11.81532 11.80310 11.79136 11.78013
## [289] 11.76946 11.75903 11.74852 11.73798 11.72742 11.71687 11.70636 11.69591
## [297] 11.68556 11.67533 11.66525 11.65535 11.64565 11.63619 11.62698 11.61805
## [305] 11.60945 11.60118 11.59328 11.58578 11.57870 11.57208 11.56593 11.56029
## [313] 11.55518 11.55063 11.54668 11.54318 11.54000 11.53713 11.53458 11.53233
## [321] 11.53039 11.52876 11.52743 11.52641 11.52568 11.52526 11.52513 11.52529
## [329] 11.52576 11.52651 11.52755 11.52888 11.53050 11.53240 11.53459 11.53706
## [337] 11.53980 11.54283 11.54613 11.54970 11.55355 11.55766 11.56205 11.56670
## [345] 11.57162 11.57680 11.58224 11.58795 11.59391 11.60013 11.60660 11.61332
## [353] 11.62030 11.62752 11.63500 11.64271 11.65068 11.65888 11.66733 11.67627
## [361] 11.68593 11.69627 11.70725 11.71881 11.73092 11.74353 11.75659 11.77007
## [369] 11.78390 11.79806 11.81249 11.82716 11.84201 11.85700 11.87208 11.88722
## [377] 11.90237 11.91747 11.93250 11.94739 11.96212 11.97663 11.99087 12.00481
## [385] 12.01840 12.03159 12.04434 12.05699 12.06990 12.08306 12.09646 12.11008
## [393] 12.12392 12.13795 12.15217 12.16657 12.18113 12.19584 12.21069 12.22567
## [401] 12.24076 12.25595 12.27123 12.28659 12.30202 12.31749 12.33301 12.34856
## [409] 12.36412 12.37969 12.39525 12.41078 12.42629 12.44180 12.45737 12.47299
## [417] 12.48867 12.50441 12.52020 12.53605 12.55196 12.56793 12.58397 12.60006
## [425] 12.61621 12.63242 12.64870 12.66504 12.68145 12.69791 12.71445 12.73105
## [433] 12.74771 12.76444 12.78124 12.79811 12.81505 12.83205 12.84912 12.86627
## [441] 12.88349 12.90077 12.91813 12.93557 12.95307 12.97065 12.98831 13.00604
## [449] 13.02384 13.04172 13.05968 13.07772 13.09583 13.11403 13.13230 13.15065
## [457] 13.16909#assign fits to a vector
both_trenda <- fit_botha
#extract y min and max for each
limits_botha <- ggplot_build(extract_botha)$data## `geom_smooth()` using formula 'y ~ x'limits_botha <- as.data.frame(limits_botha)
both_ymina <- limits_botha$ymin
both_ymaxa <- limits_botha$ymax
#reassign dataframes (just to be safe)
work_botha <- wrfa_both
#fill in missing dates to smooth fits
work_botha <- work_botha %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_botha <- work_botha$date
#create a new smooth dataframe to layer
smooth_frame_botha <- data.frame(date_vec_botha, both_trenda, both_ymina, both_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_botha, y = ~both_trenda,
data = smooth_frame_botha,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha,
'</br> Median Log Copies: ', round(both_trenda, digits = 2)),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_botha, ymin = ~both_ymina, ymax = ~both_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(both_ymina, digits = 2)),
name = "",
fillcolor = '#1B9E77',
line = list(color = '#1B9E77')) %>%
layout(yaxis = list(title = "Total Log10 SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfa_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65))
p_wrf_asave(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothb <- ggplot(wrfb_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothb<<-..y..), method = "loess", color = '#D95F02',
span = 0.6, n = 457)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothb## `geom_smooth()` using formula 'y ~ x'
fit_bothb## [1] 12.38727 12.39145 12.39558 12.39967 12.40372 12.40774 12.41171 12.41566
## [9] 12.41957 12.42346 12.42733 12.43116 12.43498 12.43879 12.44257 12.44635
## [17] 12.45011 12.45386 12.45761 12.46136 12.46511 12.46885 12.47261 12.47636
## [25] 12.48013 12.48391 12.48770 12.49151 12.49534 12.49919 12.50307 12.50697
## [33] 12.51089 12.51485 12.51885 12.52288 12.52695 12.53105 12.53521 12.53941
## [41] 12.54365 12.54795 12.55230 12.55670 12.56113 12.56560 12.57010 12.57463
## [49] 12.57919 12.58377 12.58838 12.59301 12.59765 12.60232 12.60700 12.61169
## [57] 12.61639 12.62111 12.62582 12.63055 12.63527 12.64000 12.64472 12.64944
## [65] 12.65415 12.65885 12.66355 12.66823 12.67289 12.67754 12.68217 12.68678
## [73] 12.69136 12.69592 12.70045 12.70495 12.70942 12.71386 12.71826 12.72262
## [81] 12.72694 12.73121 12.73545 12.73963 12.74377 12.74785 12.75188 12.75586
## [89] 12.75978 12.76363 12.76743 12.77116 12.77496 12.77893 12.78308 12.78739
## [97] 12.79185 12.79645 12.80117 12.80601 12.81095 12.81599 12.82111 12.82630
## [105] 12.83155 12.83685 12.84219 12.84755 12.85293 12.85832 12.86369 12.86905
## [113] 12.87438 12.87967 12.88491 12.89009 12.89519 12.90020 12.90512 12.90994
## [121] 12.91463 12.91920 12.92362 12.92789 12.93200 12.93594 12.93969 12.94324
## [129] 12.94658 12.94971 12.95261 12.95526 12.95766 12.96027 12.96349 12.96727
## [137] 12.97154 12.97623 12.98128 12.98663 12.99221 12.99796 13.00381 13.00969
## [145] 13.01555 13.02132 13.02692 13.03231 13.03740 13.04215 13.04648 13.05033
## [153] 13.05363 13.05632 13.05833 13.05961 13.06055 13.06160 13.06274 13.06397
## [161] 13.06525 13.06659 13.06796 13.06935 13.07075 13.07214 13.07350 13.07483
## [169] 13.07610 13.07731 13.07844 13.07947 13.08039 13.08118 13.08184 13.08234
## [177] 13.08267 13.08282 13.08277 13.08250 13.08202 13.08128 13.08030 13.07904
## [185] 13.07750 13.07565 13.07350 13.07101 13.06818 13.06475 13.06051 13.05550
## [193] 13.04977 13.04338 13.03638 13.02880 13.02070 13.01213 13.00314 12.99378
## [201] 12.98409 12.97413 12.96394 12.95357 12.94307 12.93249 12.92188 12.91129
## [209] 12.90076 12.89035 12.88011 12.87008 12.86031 12.85085 12.84175 12.83306
## [217] 12.82482 12.81648 12.80746 12.79778 12.78748 12.77658 12.76512 12.75311
## [225] 12.74060 12.72761 12.71416 12.70030 12.68604 12.67142 12.65646 12.64120
## [233] 12.62566 12.60987 12.59386 12.57767 12.56131 12.54482 12.52823 12.51157
## [241] 12.49486 12.47814 12.46143 12.44476 12.42817 12.41167 12.39531 12.37910
## [249] 12.36309 12.34728 12.33173 12.31645 12.30148 12.28683 12.27255 12.25866
## [257] 12.24520 12.23218 12.21964 12.20760 12.19611 12.18494 12.17386 12.16289
## [265] 12.15201 12.14123 12.13055 12.11997 12.10949 12.09911 12.08884 12.07866
## [273] 12.06858 12.05861 12.04874 12.03898 12.02932 12.01976 12.01031 12.00096
## [281] 11.99172 11.98259 11.97356 11.96464 11.95582 11.94712 11.93852 11.92998
## [289] 11.92145 11.91294 11.90448 11.89607 11.88774 11.87951 11.87139 11.86339
## [297] 11.85554 11.84784 11.84033 11.83301 11.82590 11.81902 11.81238 11.80601
## [305] 11.79991 11.79411 11.78862 11.78347 11.77865 11.77420 11.76958 11.76428
## [313] 11.75838 11.75196 11.74507 11.73781 11.73022 11.72240 11.71442 11.70633
## [321] 11.69823 11.69017 11.68223 11.67449 11.66701 11.65987 11.65314 11.64689
## [329] 11.64120 11.63613 11.63176 11.62817 11.62541 11.62358 11.62273 11.62294
## [337] 11.62428 11.62654 11.62943 11.63290 11.63692 11.64144 11.64643 11.65185
## [345] 11.65765 11.66380 11.67026 11.67698 11.68392 11.69105 11.69832 11.70570
## [353] 11.71314 11.72060 11.72805 11.73545 11.74274 11.74990 11.75688 11.76399
## [361] 11.77153 11.77949 11.78785 11.79659 11.80569 11.81514 11.82491 11.83499
## [369] 11.84536 11.85600 11.86688 11.87801 11.88934 11.90087 11.91258 11.92445
## [377] 11.93645 11.94858 11.96082 11.97313 11.98551 11.99794 12.01040 12.02287
## [385] 12.03533 12.04777 12.06016 12.07264 12.08536 12.09832 12.11151 12.12493
## [393] 12.13857 12.15243 12.16651 12.18079 12.19528 12.20998 12.22487 12.23995
## [401] 12.25523 12.27069 12.28632 12.30214 12.31813 12.33428 12.35060 12.36708
## [409] 12.38371 12.40050 12.41743 12.43450 12.45171 12.46907 12.48658 12.50425
## [417] 12.52208 12.54006 12.55821 12.57651 12.59497 12.61358 12.63236 12.65130
## [425] 12.67039 12.68964 12.70906 12.72863 12.74837 12.76826 12.78832 12.80853
## [433] 12.82891 12.84945 12.87015 12.89101 12.91204 12.93323 12.95458 12.97609
## [441] 12.99777 13.01961 13.04161 13.06378 13.08611 13.10861 13.13127 13.15409
## [449] 13.17708 13.20024 13.22356 13.24705 13.27070 13.29452 13.31851 13.34266
## [457] 13.36699#assign fits to a vector
both_trendb <- fit_bothb
#extract y min and max for each
limits_bothb <- ggplot_build(extract_bothb)$data## `geom_smooth()` using formula 'y ~ x'limits_bothb <- as.data.frame(limits_bothb)
both_yminb <- limits_bothb$ymin
both_ymaxb <- limits_bothb$ymax
#reassign dataframes (just to be safe)
work_bothb <- wrfb_both
#fill in missing dates to smooth fits
work_bothb <- work_bothb %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothb <- work_bothb$date
#create a new smooth dataframe to layer
smooth_frame_bothb <- data.frame(date_vec_bothb, both_trendb, both_yminb, both_ymaxb)#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothb, y = ~both_trendb,
data = smooth_frame_bothb,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb,
'</br> Median Log Copies: ', round(both_trendb, digits = 2)),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothb, ymin = ~both_yminb, ymax = ~both_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(both_yminb, digits = 2)),
name = "",
fillcolor = '#D95F02',
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log10 SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfb_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")#**************************************WRF C PLOT********************************************** #add trendlines #extract data from geom_smooth # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothc <- ggplot(wrfc_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothc<<-..y..), method = "loess", color = '#E7298A',
span = 0.6, n = 457)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothc## `geom_smooth()` using formula 'y ~ x'
fit_bothc## [1] 11.82685 11.82757 11.82829 11.82900 11.82972 11.83043 11.83114 11.83185
## [9] 11.83258 11.83331 11.83404 11.83479 11.83556 11.83634 11.83713 11.83795
## [17] 11.83878 11.83964 11.84053 11.84144 11.84238 11.84335 11.84435 11.84539
## [25] 11.84646 11.84757 11.84873 11.84992 11.85116 11.85244 11.85378 11.85516
## [33] 11.85660 11.85809 11.85963 11.86124 11.86290 11.86462 11.86641 11.86826
## [41] 11.87019 11.87218 11.87424 11.87637 11.87858 11.88087 11.88323 11.88568
## [49] 11.88821 11.89083 11.89354 11.89635 11.89927 11.90229 11.90540 11.90860
## [57] 11.91189 11.91526 11.91871 11.92223 11.92583 11.92949 11.93322 11.93701
## [65] 11.94085 11.94474 11.94869 11.95267 11.95670 11.96077 11.96486 11.96899
## [73] 11.97314 11.97732 11.98151 11.98572 11.98994 11.99416 11.99838 12.00261
## [81] 12.00683 12.01104 12.01524 12.01942 12.02358 12.02772 12.03183 12.03591
## [89] 12.03995 12.04395 12.04791 12.05183 12.05569 12.05950 12.06325 12.06694
## [97] 12.07056 12.07411 12.07759 12.08111 12.08480 12.08864 12.09262 12.09674
## [105] 12.10097 12.10533 12.10978 12.11433 12.11897 12.12368 12.12846 12.13330
## [113] 12.13818 12.14309 12.14804 12.15300 12.15797 12.16294 12.16790 12.17283
## [121] 12.17774 12.18261 12.18742 12.19218 12.19687 12.20148 12.20600 12.21043
## [129] 12.21474 12.21894 12.22302 12.22695 12.23074 12.23438 12.23785 12.24178
## [137] 12.24675 12.25267 12.25945 12.26702 12.27528 12.28416 12.29356 12.30340
## [145] 12.31360 12.32406 12.33472 12.34547 12.35624 12.36695 12.37749 12.38780
## [153] 12.39778 12.40736 12.41644 12.42493 12.43277 12.43985 12.44610 12.45143
## [161] 12.45575 12.45992 12.46481 12.47037 12.47654 12.48328 12.49052 12.49822
## [169] 12.50633 12.51479 12.52355 12.53256 12.54177 12.55112 12.56056 12.57004
## [177] 12.57951 12.58892 12.59820 12.60732 12.61621 12.62483 12.63312 12.64103
## [185] 12.64851 12.65550 12.66196 12.66783 12.67306 12.67760 12.68139 12.68438
## [193] 12.68652 12.68776 12.68804 12.68732 12.68520 12.68142 12.67610 12.66939
## [201] 12.66140 12.65227 12.64213 12.63111 12.61934 12.60695 12.59407 12.58084
## [209] 12.56738 12.55382 12.54030 12.52694 12.51387 12.50123 12.48915 12.47775
## [217] 12.46717 12.45754 12.44899 12.44053 12.43114 12.42085 12.40969 12.39771
## [225] 12.38493 12.37141 12.35716 12.34223 12.32666 12.31048 12.29373 12.27645
## [233] 12.25867 12.24044 12.22177 12.20273 12.18333 12.16362 12.14363 12.12341
## [241] 12.10298 12.08239 12.06167 12.04086 12.01999 11.99910 11.97824 11.95742
## [249] 11.93670 11.91611 11.89569 11.87546 11.85548 11.83577 11.81637 11.79733
## [257] 11.77867 11.76043 11.74265 11.72537 11.70863 11.69245 11.67688 11.66196
## [265] 11.64771 11.63419 11.62082 11.60706 11.59296 11.57858 11.56398 11.54920
## [273] 11.53431 11.51935 11.50438 11.48946 11.47464 11.45998 11.44553 11.43134
## [281] 11.41746 11.40397 11.39090 11.37831 11.36626 11.35480 11.34399 11.33388
## [289] 11.32452 11.31565 11.30694 11.29842 11.29008 11.28194 11.27400 11.26628
## [297] 11.25878 11.25150 11.24447 11.23767 11.23113 11.22485 11.21885 11.21312
## [305] 11.20767 11.20252 11.19767 11.19313 11.18891 11.18502 11.18146 11.17824
## [313] 11.17538 11.17287 11.17074 11.16892 11.16737 11.16608 11.16506 11.16430
## [321] 11.16381 11.16357 11.16360 11.16388 11.16442 11.16522 11.16627 11.16758
## [329] 11.16914 11.17095 11.17301 11.17531 11.17787 11.18067 11.18372 11.18701
## [337] 11.19055 11.19432 11.19834 11.20260 11.20709 11.21182 11.21679 11.22199
## [345] 11.22742 11.23309 11.23899 11.24511 11.25147 11.25805 11.26486 11.27189
## [353] 11.27915 11.28663 11.29433 11.30225 11.31039 11.31875 11.32732 11.33633
## [361] 11.34597 11.35621 11.36700 11.37831 11.39010 11.40234 11.41499 11.42801
## [369] 11.44137 11.45503 11.46894 11.48309 11.49742 11.51190 11.52649 11.54116
## [377] 11.55587 11.57059 11.58527 11.59988 11.61438 11.62874 11.64291 11.65687
## [385] 11.67057 11.68399 11.69707 11.71011 11.72343 11.73701 11.75083 11.76490
## [393] 11.77918 11.79368 11.80837 11.82325 11.83831 11.85353 11.86889 11.88440
## [401] 11.90003 11.91577 11.93161 11.94755 11.96355 11.97962 11.99575 12.01191
## [409] 12.02810 12.04430 12.06050 12.07670 12.09287 12.10906 12.12532 12.14166
## [417] 12.15806 12.17454 12.19108 12.20771 12.22440 12.24117 12.25801 12.27493
## [425] 12.29193 12.30900 12.32615 12.34337 12.36068 12.37806 12.39552 12.41307
## [433] 12.43069 12.44840 12.46618 12.48405 12.50200 12.52004 12.53816 12.55637
## [441] 12.57466 12.59303 12.61150 12.63005 12.64869 12.66741 12.68623 12.70514
## [449] 12.72413 12.74322 12.76240 12.78167 12.80103 12.82049 12.84004 12.85968
## [457] 12.87942#assign fits to a vector
both_trendc <- fit_bothc
#extract y min and max for each
limits_bothc <- ggplot_build(extract_bothc)$data## `geom_smooth()` using formula 'y ~ x'limits_bothc <- as.data.frame(limits_bothc)
both_yminc <- limits_bothc$ymin
both_ymaxc <- limits_bothc$ymax
#reassign dataframes (just to be safe)
work_bothc <- wrfc_both
#fill in missing dates to smooth fits
work_bothc <- work_bothc %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothc <- work_bothc$date
#create a new smooth dataframe to layer
smooth_frame_bothc <- data.frame(date_vec_bothc, both_trendc, both_yminc, both_ymaxc)#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothc, y = ~both_trendc,
data = smooth_frame_bothc,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc,
'</br> Median Log Copies: ', round(both_trendc, digits = 2)),
line = list(color = '#E7298A', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothc, ymin = ~both_yminc, ymax = ~both_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(both_yminc, digits = 2)),
name = "",
fillcolor = '#E7298A',
line = list(color = '#E7298A')) %>%
layout(yaxis = list(title = "Total Log10 SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfc_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#E7298A', size = 6, opacity = 0.65))
p_wrf_csave(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")save(wrfa_both, file = "./plotly_objs/wrfa_both.rda")
save(wrfb_both, file = "./plotly_objs/wrfb_both.rda")
save(wrfc_both, file = "./plotly_objs/wrfc_both.rda")save(date_vec_botha, file = "./plotly_objs/date_vec_botha.rda")
save(date_vec_bothb, file = "./plotly_objs/date_vec_bothb.rda")
save(date_vec_bothc, file = "./plotly_objs/date_vec_bothc.rda")save(both_ymina, file = "./plotly_objs/both_ymina.rda")
save(both_ymaxa, file = "./plotly_objs/both_ymaxa.rda")
save(both_yminb, file = "./plotly_objs/both_yminb.rda")
save(both_ymaxb, file = "./plotly_objs/both_ymaxb.rda")
save(both_yminc, file = "./plotly_objs/both_yminc.rda")
save(both_ymaxc, file = "./plotly_objs/both_ymaxc.rda")